home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Src / char.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-05-04  |  5.6 KB  |  228 lines
  1. /*
  2.  *
  3.  * c h a r . c                -- Characters management
  4.  *
  5.  * Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  6.  * 
  7.  *
  8.  * Permission to use, copy, and/or distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that both the above copyright notice and this permission notice appear in
  11.  * all copies and derived works.  Fees for distribution or use of this
  12.  * software or derived works may only be charged with express written
  13.  * permission of the copyright holder.  
  14.  * This software is provided ``as is'' without express or implied warranty.
  15.  *
  16.  * This software is a derivative work of other copyrighted softwares; the
  17.  * copyright notices of these softwares are placed in the file COPYRIGHTS
  18.  *
  19.  *
  20.  *           Author: Erick Gallesio [eg@kaolin.unice.fr]
  21.  *    Creation date: ??????
  22.  * Last file update:  4-May-1996 11:18
  23.  */
  24.  
  25. #include <ctype.h>
  26. #include "stk.h"
  27.  
  28. struct charelem {
  29.   char *name;
  30.   char value;
  31. };
  32.  
  33. static struct charelem chartable [] = { 
  34.   "null",       '\000',
  35.   "bell",       '\007',
  36.   "backspace",  '\010',
  37.   "newline",    '\012',
  38.   "page",       '\014',
  39.   "return",     '\015',
  40.   "escape",     '\033',
  41.   "space",      '\040',
  42.   "delete",     '\177',
  43.  
  44.   /* poeticless names */
  45.   "nul",        '\000',
  46.   "soh",        '\001',
  47.   "stx",        '\002',
  48.   "etx",        '\003',
  49.   "eot",        '\004',
  50.   "enq",        '\005',
  51.   "ack",        '\006',
  52.   "bel",        '\007',
  53.  
  54.   "bs",         '\010',
  55.   "ht",         '\011',
  56.   "tab",        '\011',
  57.   "nl",         '\012',
  58.   "vt",         '\013',
  59.   "np",         '\014',
  60.   "cr",         '\015',
  61.   "so",         '\016',
  62.   "si",         '\017',
  63.  
  64.   "dle",        '\020',
  65.   "dc1",        '\021',
  66.   "dc2",        '\022',
  67.   "dc3",        '\023',
  68.   "dc4",        '\024',
  69.   "nak",        '\025',
  70.   "syn",        '\026',
  71.   "etb",        '\027',
  72.  
  73.   "can",        '\030',
  74.   "em",         '\031',
  75.   "sub",        '\032',
  76.   "esc",        '\033',
  77.   "fs",         '\034',
  78.   "gs",         '\035',
  79.   "rs",         '\036',
  80.   "us",         '\037',
  81.  
  82.   "sp",        '\040',                      
  83.   "del",    '\177',
  84.   
  85.   "",           '\000'};
  86.  
  87.  
  88. static int my_strcmpi(register char *p1, register char *p2)
  89. {
  90.   for( ; tolower(*p1) == tolower(*p2); p1++, p2++) 
  91.     if (!*p1) return 0;
  92.  
  93.   return tolower(*p1) - tolower(*p2);
  94. }
  95.  
  96.  
  97.  
  98. char STk_string2char(char *s)
  99. /* converts a char name to a char */
  100. {
  101.   register struct charelem *p;
  102.   int diff;
  103.   
  104.   if (s[1] == '\000') return s[0];
  105.   for (p=chartable; *(p->name); p++) {
  106.     if (my_strcmpi(p->name, s) == 0) return p->value;
  107.   }
  108.   Err("Bad char name", NIL);
  109.   return '\0'; /* never reached */
  110. }
  111.  
  112. char *STk_char2string(char c)  /* convert a char to it's external representation */
  113. {
  114.   static char result[2] = " ";  /* sets the \0 */
  115.   register struct charelem *p;
  116.  
  117.   for (p=chartable; *(p->name); p++)
  118.     if (p->value == c) return p->name;
  119.   
  120.   /* If we are here it's a "normal" char */
  121.   *result = c;
  122.   return result;
  123. }
  124.  
  125. SCM STk_makechar(char c)
  126. {
  127.   SCM z;
  128.  
  129. #ifndef COMPACT_SMALL_CST
  130.   NEWCELL(z,tc_char);
  131. #endif
  132.   SET_CHARACTER(z, c);
  133.   return z;
  134. }
  135.  
  136.  
  137. /**** Section 6.6 ****/
  138.  
  139. PRIMITIVE STk_charp(SCM obj)
  140. {
  141.   return CHARP(obj) ? Truth: Ntruth;
  142. }
  143.  
  144. static int charcomp(SCM c1, SCM c2)
  145. {
  146.   if (NCHARP(c1)) Err("comparing char: bad char", c1); 
  147.   if (NCHARP(c2)) Err("comparing char: bad char", c2);
  148.   
  149.   return (CHAR(c1) - CHAR(c2));
  150. }
  151.  
  152. static int charcompi(SCM c1, SCM c2)
  153. {
  154.   if (NCHARP(c1)) Err("comparing char: bad char", c1); 
  155.   if (NCHARP(c2)) Err("comparing char: bad char", c2);
  156.   
  157.   return (tolower(CHAR(c1)) - tolower(CHAR(c2)));
  158. }
  159.   
  160. PRIMITIVE STk_chareq   (SCM c1, SCM c2){return (charcomp(c1,c2)==0) ?Truth: Ntruth;}
  161. PRIMITIVE STk_charless (SCM c1, SCM c2){return (charcomp(c1,c2)<0)  ?Truth: Ntruth;}
  162. PRIMITIVE STk_chargt   (SCM c1, SCM c2){return (charcomp(c1,c2)>0)  ?Truth: Ntruth;}
  163. PRIMITIVE STk_charlesse(SCM c1, SCM c2){return (charcomp(c1,c2)<=0) ?Truth: Ntruth;}
  164. PRIMITIVE STk_chargte  (SCM c1, SCM c2){return (charcomp(c1,c2)>=0) ?Truth: Ntruth;}
  165.  
  166. PRIMITIVE STk_chareqi   (SCM c1, SCM c2){return (charcompi(c1,c2)==0)?Truth:Ntruth;}
  167. PRIMITIVE STk_charlessi (SCM c1, SCM c2){return (charcompi(c1,c2)<0) ?Truth:Ntruth;}
  168. PRIMITIVE STk_chargti   (SCM c1, SCM c2){return (charcompi(c1,c2)>0) ?Truth:Ntruth;}
  169. PRIMITIVE STk_charlessei(SCM c1, SCM c2){return (charcompi(c1,c2)<=0)?Truth:Ntruth;}
  170. PRIMITIVE STk_chargtei  (SCM c1, SCM c2){return (charcompi(c1,c2)>=0)?Truth:Ntruth;}
  171.  
  172. PRIMITIVE STk_char_alphap(SCM c)
  173. {
  174.   if (NCHARP(c)) Err("char-alphabetic?: bad character", c);
  175.   return isalpha(CHAR(c))? Truth: Ntruth;
  176. }
  177.  
  178. PRIMITIVE STk_char_numericp(SCM c)
  179. {
  180.   if (NCHARP(c)) Err("char-numeric?: bad character", c);
  181.   return isdigit(CHAR(c))? Truth: Ntruth;
  182. }
  183.  
  184. PRIMITIVE STk_char_whitep(SCM c)
  185. {
  186.   if (NCHARP(c)) Err("char-whitespace?: bad character", c);
  187.   return isspace(CHAR(c))? Truth: Ntruth;
  188. }
  189.  
  190. PRIMITIVE STk_char_upperp(SCM c)
  191. {
  192.   if (NCHARP(c)) Err("char-upper-case?: bad character", c);
  193.   return isupper(CHAR(c))? Truth: Ntruth;
  194. }
  195.  
  196. PRIMITIVE STk_char_lowerp(SCM c)
  197. {
  198.   if (NCHARP(c)) Err("char-lower-case?: bad character", c);
  199.   return islower(CHAR(c))? Truth: Ntruth;
  200. }
  201.  
  202. PRIMITIVE STk_char2integer(SCM c)
  203. {
  204.   if (NCHARP(c)) Err("char->integer: bad character", c);
  205.   return STk_makeinteger((long) CHAR(c));
  206. }
  207.  
  208. PRIMITIVE STk_integer2char(SCM i)
  209. {
  210.   int c = STk_integer_value(i);
  211.  
  212.   if (c < 0 || c > MAX_CHAR_CODE) Err("integer->char: bad integer", i);
  213.   return STk_makechar(c);
  214. }
  215.  
  216. PRIMITIVE STk_char_upper(SCM c)
  217. {
  218.   if (NCHARP(c)) Err("char-upcase: bad character", c);
  219.   return STk_makechar(toupper(CHAR(c)));
  220. }
  221.  
  222. PRIMITIVE STk_char_lower(SCM c)
  223. {
  224.   if (NCHARP(c)) Err("char-downcase: bad character", c);
  225.   return STk_makechar(tolower(CHAR(c)));
  226. }
  227.  
  228.